home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / queue.scm < prev    next >
Text File  |  1999-04-19  |  2KB  |  73 lines
  1. ; "queue.scm"  Queues/Stacks for Scheme
  2. ; Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.
  3. ;
  4. ; This code is in the public domain.
  5.  
  6. (require 'record)
  7.  
  8. ; Elements in a queue are stored in a list.  The last pair in the list
  9. ; is stored in the queue type so that datums can be added in constant
  10. ; time.
  11.  
  12. (define queue:record-type
  13.   (make-record-type "queue" '(first-pair last-pair)))
  14. (define make-queue
  15.   (let ((construct-queue (record-constructor queue:record-type)))
  16.     (lambda ()
  17.       (construct-queue '() '()))))
  18.  
  19. (define queue? (record-predicate queue:record-type))
  20.  
  21. (define queue:first-pair (record-accessor queue:record-type
  22.                       'first-pair))
  23. (define queue:set-first-pair! (record-modifier queue:record-type
  24.                            'first-pair))
  25. (define queue:last-pair (record-accessor queue:record-type
  26.                      'last-pair))
  27. (define queue:set-last-pair! (record-modifier queue:record-type
  28.                           'last-pair))
  29.  
  30. (define (queue-empty? q)
  31.   (null? (queue:first-pair q)))
  32.  
  33. (define (queue-front q)
  34.   (let ((first-pair (queue:first-pair q)))
  35.     (if (null? first-pair)
  36.     (slib:error "queue is empty" q))
  37.     (car first-pair)))
  38.  
  39. (define (queue-rear q)
  40.   (let ((last-pair (queue:last-pair q)))
  41.     (if (null? last-pair)
  42.     (slib:error "queue is empty" q))
  43.     (car last-pair)))
  44.  
  45. (define (queue-push! q datum)
  46.   (let* ((old-first-pair (queue:first-pair q))
  47.      (new-first-pair (cons datum old-first-pair)))
  48.     (queue:set-first-pair! q new-first-pair)
  49.     (if (null? old-first-pair)
  50.     (queue:set-last-pair! q new-first-pair)))
  51.   q)
  52.     
  53. (define (enqueue! q datum)
  54.   (let ((new-pair (cons datum '())))
  55.     (cond ((null? (queue:first-pair q))
  56.        (queue:set-first-pair! q new-pair))
  57.       (else
  58.        (set-cdr! (queue:last-pair q) new-pair)))
  59.     (queue:set-last-pair! q new-pair))
  60.   q)
  61.  
  62. (define (dequeue! q)
  63.   (let ((first-pair (queue:first-pair q)))
  64.     (if (null? first-pair)
  65.     (slib:error "queue is empty" q))
  66.     (let ((first-cdr (cdr first-pair)))
  67.       (queue:set-first-pair! q first-cdr)
  68.       (if (null? first-cdr)
  69.       (queue:set-last-pair! q '()))
  70.       (car first-pair))))
  71.  
  72. (define queue-pop! dequeue!)
  73.